library(data.table)
library(stringi)
library(dplyr)
library(stringr)
library(text2vec)
library(readxl)
library(Matrix)
library(text2vec)
library(rdrop2)
library(ggplot2)
library(plotly)
library(magrittr)
library(stringdist)
library(xgboost)
# GESTION DE LA CONVERSION DES NOMBRES EN CHAINE DE CARACTERES SANS UTILISER LA NOTATION SCIENTIFIQUE
# https://stackoverflow.com/questions/5352099/how-to-disable-scientific-notation
options("scipen"=100, "digits"=10)
data2 <- fread("data/29032018_Index2.csv",encoding="Latin-1")
nb_indicateurs=nrow(data2)
Le jeu de données contient indicateurs.
Les données sont principalement textuelles, certaines peut-être plus exploitables que d’autres.
names(data2)
## [1] "index"
## [2] "Base"
## [3] "Indicateur"
## [4] "Famille"
## [5] "Famille Finale_DREES"
## [6] "Classement producteur Niveau 3 (le plus détaillé)"
## [7] "Classement producteur Niveau 2"
## [8] "Classement producteur Niveau 1 (le moins détaillé)"
## [9] "thème_DREES"
## [10] "Domaine 1_DREES"
## [11] "Domaine 2_DREES"
## [12] "Domaine 3_DREES"
## [13] "Source"
## [14] "Producteur"
## [15] "Echelle géo. nationale"
## [16] "Echelle géo. Rég"
## [17] "Echelle géo dep"
## [18] "Autre échelle de restitution"
## [19] "Profondeur historique"
## [20] "Fréquence d'actualisation"
## [21] "Commentaires"
## [22] "Base"
## [23] "Date version base"
## [24] "Type d'accès"
## [25] "Accéder à la base"
## [26] "Producteur de la base"
## [27] "index"
head(data2,2)#Un View(head(data2,100)) sera peut-être plus approprié pour vous.
La variable index est présente deux fois !
On vérifie que c’est bien les mêmes valeurs les deux fois puis on supprime
data2[c(!data2[,1]==data2[,27]),c(1,27)]
data2[,27] <- NULL
La variable Base est présente deux fois !
Même procédure, on observe des différences mais c’est seulement des problèmes de majuscules.
head(data2[c(!data2[,2]==data2[,22]),c(2,22)])
data2[c(!tolower(data2[,2])==tolower(data2[,22])),c(2,22)]
data2[,22] <- NULL
En particulier certaines méritent peut-être un pré-traitement, par exemple les noms des producteurs INSEE, DREES, CNAMTS écrit en plein texte.
head(sample(data2$Producteur))
## [1] "Caisse Nationale de l'Assurance Maladie des Travailleurs Salariés (CNAMTS)"
## [2] "Agence technique de l'information sur l'hospitalisation (ATIH)"
## [3] "Institut national de la statistique et des études économiques (Insee)"
## [4] "Agence régionale de santé (ARS)"
## [5] "Agence technique de l'information sur l'hospitalisation (ATIH)"
## [6] "Direction de la recherche des études de l’évaluation et des statistiques (DREES), Institut national de la statistique et des études économiques (Insee)"
Commençons par une expression régulière pour récupérer le texte entre parenthèses (acronyme)
data2$producteur_acronyme=data2$Producteur%>%
stri_extract_all(regex = "(\\()([A-z]+)(\\))")%>%#On récupère LES chaînes de caractères entre parenthèses
lapply(function(x)paste(x,collapse=" "))%>%# On les colle
unlist%>%gsub(pattern = '(\\()|(\\))',replacement = '') # On met en vecteur et on supprime les parenthèses
data2[producteur_acronyme=="NA",producteur_acronyme:=Producteur]#On gère les noms sans acronyme
table(data2$producteur_acronyme)%>%head
##
## Agence de l'eau Air Paca ANMDA
## 153 3 8 1
## ANSM ARS
## 1 254
Même idée pour la source
data2$source_acronyme=data2$Source%>%
stri_extract_all(regex = "(\\()([A-z]+)(\\))")%>%#On récupère LES chaînes de caractères entre parenthèses
lapply(function(x)paste(x,collapse=" "))%>%# On les colle
unlist%>%gsub(pattern = '(\\()|(\\))',replacement = '') # On met en vecteur et on supprime les parenthèses
data2[source_acronyme=="NA",source_acronyme:=Source]#On gère les noms sans acronyme
table(data2$source_acronyme)%>%head
##
## Accidents de la circulation
## 2283 3
## Adeli Adeli RPPS
## 9 13
## AGATA ALD
## 3 82
Pour remplacer plusieurs mots d’un coup, stringr propose une fonction polymorphe très pratique str_replace_all. Lorsqu’on fournit un vecteur nommé à la place des paramètres pattern et replacement, la fonction est appliquée au vecteur de sorte que pour chaque entrée du vecteur, le nom joue le rôle de pattern et la valeur joue le rôle de replacement.
On commence par construire notre liste de stopwords.
stop_words = tm::stopwords(kind="fr")
# stop_words=c(stop_words,"actifs part entière APE")
stop_words=paste0(" ",stop_words," ")
stop_words=c(stop_words," c'"," l'"," d'"," j'"," t'"," m'"," s'")
fix_stop=rep(" ",length(stop_words))
names(fix_stop) <- stop_words
Puis on passe en minuscules, on supprime les stopwords puis les espaces en trop.
data2 <- data2%>%
mutate(Indicateur=as.character(Indicateur))%>%#passage en char
mutate_if(is.character,tolower)%>%#en minuscules
mutate_if(is.character,function(x)str_replace_all(x,fix_stop))%>%#suppression de stopwords génériques et spécifiques
mutate_if(is.character,tm::stripWhitespace)#suppression des doubles espaces
cardinality=sapply(data2,function(x)length(unique(x)))
head(cardinality)
## index
## 18885
## Base
## 25
## Indicateur
## 18360
## Famille
## 1933
## Famille Finale_DREES
## 1
## Classement producteur Niveau 3 (le plus détaillé)
## 410
data2=data2[,cardinality>1]
data2$Indicateur_enriched=paste(data2$Indicateur,
data2$Famille,
data2$`Classement producteur Niveau 1 (le moins détaillé)`,
data2$`Classement producteur Niveau 2`,
data2$`Classement producteur Niveau 3 (le plus détaillé)`,
data2$source_acronyme,data2$producteur_acronyme)
Longueur du texte :
nchar(data2$Indicateur)%>%hist(main="Distribution du nombre de caractères dans le texte")
On va compter les espaces pour se donner une idée du nombre de mots
str_count(data2$Indicateur," ")%>%hist(main="Distribution du nombre de mots dans le texte")
On échantillonne sur les indicateurs et non directement sur les couples indicateurs x tags.
train_smp=sample(tagged_ids,size = round(.75*length(tagged_ids)))
test_smp = setdiff(tagged_ids, train_smp)
train_ind=rowSums(expand.grid((1:length(tags)-1)*nb_indicateurs,train_smp))
test_ind=rowSums(expand.grid((1:length(tags)-1)*nb_indicateurs,test_smp))
On va sélectionner uniquement les colonnes pertinentes pour l’apprentissage pour ça on a recours à colSums pour vérifier si les colonnes sont constantes égales à 0.
Remarque : Cette pratique nous donne une piste pour l’active learning, on pourra sélectionner les indicateurs les moins bien représentés par le vocabulaire actuellement taggé
ngrams_tagged <- which(colSums(dtm_sp[c(train_ind,test_ind),])>0)
knowns_ind <- tagged_triplet[tagged_triplet$id%in%train_ind,][['i']]
train_ind <- train_ind[train_ind%in%knowns_ind]
train_ind <- sort(train_ind)
train_labels <- tagged_triplet[tagged_triplet$id%in%train_ind,]%>%
arrange(i)%>%.[['value']]
train_dtm <- dtm_sp[train_ind,ngrams_tagged]
dtrain <- xgb.DMatrix(data = as(train_dtm,"dgCMatrix"),
label = train_labels)
## Même chose pour le test qui va aussi nous servir de validation ici parce qu'on ne fait pas de gridsearch.
knowns_ind <- tagged_triplet[tagged_triplet$id%in%test_ind,][['i']]
test_ind <- test_ind[test_ind%in%knowns_ind]
test_ind <- sort(test_ind)
test_labels <- tagged_triplet[tagged_triplet$id%in%test_ind,]%>%
arrange(i)%>%.[['value']]
test_dtm <- dtm_sp[test_ind,ngrams_tagged]
dtest <- xgb.DMatrix(data = as(test_dtm,"dgCMatrix"),
label = test_labels)
watchlist <- list(train = dtrain,eval = dtest)
On propose deux stratégies d’apprentissage, la première robuste et lente pour le modèle final, la seconde rapide et “suffisante” pour de l’active learning.
timing="fast"
if (timing=="slow"){
params=list(eta=.1,
max_depth=6,
min_child_weight=5,
subsample=500*length(tags)/length(train_ind),
colsample_bytree=8000/length(ngrams_tagged),
objective="binary:logistic",
eval_metric="auc",
gamma=.01)
nrounds=5E+3
} else if (timing=="fast"){
params=list(eta=.2,
max_depth=8,
min_child_weight=1,
subsample=500*length(tags)/length(train_ind),
colsample_bytree=300/length(ngrams_tagged),
objective="binary:logistic",
eval_metric="auc",
gamma=.01)
nrounds=1E+3
}
On lance xgboost
system.time(xgbmodel <- xgb.train(params = params,dtrain,
verbose = 1,print_every_n = 10,
nrounds = nrounds,watchlist,
early_stopping_rounds=200))
save(xgbmodel,file="trained_model.RData")
load("trained_model.RData")
Les ngrams précédés de __ sont ceux relatifs aux tags.
Le feature notions est la variable générée à partir du dictionnaire des notions. Elle devrait fonctionner à tous les coups mais on a vu que ce n’est pas toujours le cas.
Gain contribution of each feature to the model. For boosted tree model, each gain of each feature of each tree is taken into account, then average per feature to give a vision of the entire model. Highest percentage means important feature to predict the label used for the training (only available for tree models);
Cover metric of the number of observation related to this feature (only available for tree models);
Weight percentage representing the relative number of times a feature have been taken into trees.
imp=xgb.importance(feature_names = NULL,xgbmodel)
head(imp,100)
get_imp_ngrams=data.table(i=i,j=j)
dico_ngrams=data.frame(j=1:max(j),ngram=dimnm[[2]])
get_imp_ngrams=merge(get_imp_ngrams,dico_ngrams,by="j")
get_imp_ngrams=merge(get_imp_ngrams,imp,by.x="ngram",by.y="Feature")
setorder(get_imp_ngrams,-Gain)
get_imp_ngrams[,order:=1:.N,by="i"]
get_imp_ngrams=get_imp_ngrams[order<=10]
get_imp_ngrams=dcast(get_imp_ngrams,i~order,value.var="ngram")
get_imp_ngrams=merge(get_imp_ngrams,data2[,c("index","Indicateur")],by.x="i",by.y="index")
sample_n(get_imp_ngrams%>%select(-i),10)
On remarque que des stopwords nous ont échappé… mais manifestement ils n’étaient pas si “creux” puisque le modèle les a retenu.
Si on voit les choses autrement, on peut se dire que lorsque le ngram influent est un stopwords, les autres ngrams moins influents ne sont probablement pas pertinent. De plus si LE ngram le plus influent est un stopword, alors l’indicateur est probablement mal taggé…